home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Language/OS - Multiplatform Resource Library
/
LANGUAGE OS.iso
/
b
/
b.lha
/
B
/
src
/
bint
/
b3fil.c
< prev
next >
Wrap
C/C++ Source or Header
|
1988-11-24
|
7KB
|
303 lines
/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1985. */
/*
$Header: b3fil.c,v 1.4 85/08/27 10:56:00 timo Exp $
*/
/* Facilities supplied by the file system */
#include "b.h"
#include "b0con.h"
#include "b0fea.h"
#include "b0fil.h"
#include "b1obj.h"
#include "b3scr.h"
#include "b3err.h"
#include "b3fil.h"
#ifndef INTEGRATION
/*This file defines the facilities needed for dealing with files,
apart from C's standard I/O facilities which are used throughout the system.
Units are held on files in a 'workspace', which on Unix is modelled
using directories. The function 'f_uname' converts a unit name into a
unique filename. On Unix this is done by prepending a character to the unit
name to indicate the kind of unit (for how'to ', and for tests and yields
< for zeroadic, " for monadic and > for dyadic; these have been chosen as
characters that are not usually used in filenames), and truncating the
name if necessary. If the name does have to be truncated, then it is
hashed to produce a character that is appended to the filename, in an attempt
to produce a unique filename. Even so, it is still possible for different
unit names to produce the same filename, and in the unlikely event of this
happening you get an error message that the unit already exists when you
try to create the clashing unit name.
Filenames are at most SAFEFNLEN characters long, which on standard Unix
systems gives you one spare character for making backups or whatever.
It would be better if the B system effectively maintained its own directories
that mapped units onto files in the real file system, as is done for targets.
With operating systems with a more limited file system (eg even shorter
filenames) this is the only possibility.
The B system can operate in two ways: with the interpreter in command,
and then the editor is called from the interpreter to edit units;
and with the editor in command, when the editor calls the interpreter to
execute commands. The variable 'filtered' is Yes when the editor is in
command, and No otherwise.
*/
#define COML 60
Hidden char com_line[COML];
#define At_eos(s) ((s)+= strlen(s))
Visible Procedure f_edit(fname, errline) value fname; intlet errline; {
/*The default editor is called with a first parameter of the line number
and a second parameter of the file name*/
string cl= com_line; char c;
#ifdef unix
if (filtered) {
printf("\001: +%d %s\n", errline, strval(fname));
fflush(stdout);
do { c= fgetc(stdin); } while (c != '\n');
still_ok= Yes; /*ignore interrupts that occurred*/
} else {
strcpy(cl, editorfile);
if (*(cl+strlen(cl)-1) == '+') {
if (errline != 0) sprintf(At_eos(cl), "%d", errline);
else *(cl+strlen(cl)-1)= ' ';
}
app_fname(At_eos(cl), fname);
system(com_line);
}
#else !unix
fprintf(stderr, "*** Editing units not yet implemented\n");
#endif unix
}
#else INTEGRATION
Visible Procedure
f_edit(fname, errline, prompt)
value fname; intlet errline; literal prompt;
{
string filename= Str(fname);
btop(&filename, errline, prompt, 0);
still_ok= Yes;
}
#endif
Visible bool ws_writable() {
FILE *f= fopen(tempfile, "w");
if (f == NULL) return No;
fclose(f);
return Yes;
}
Hidden bool f_copy(fname, sname) value fname, sname; {
string fn= strval(fname), sn;
FILE *fp= fopen(fn, "r"), *sp; int c; bool ok;
if (fp == NULL) return No;
sn= strval(sname);
sp= fopen(sn, "w");
if (sp == NULL) {
fclose(fp);
return No;
}
while ((c= getc(fp)) != EOF)
putc(c, sp);
fclose(fp);
ok= fflush(sp) != EOF;
if (fclose(sp) == EOF)
ok= No;
return ok;
}
Visible value f_save(fname) value fname; {
/* saves the file in a temporary file, whose name is returned */
value sname= mk_text(tempfile);
VOID f_copy(fname, sname);
return sname;
}
Visible Procedure f_rename(fname, nfname) value fname, nfname; {
char *f1, f2[100];
strcpy(f2, strval(nfname));
unlink(f2);
f1= strval(fname);
#ifndef RENAME
link(f1, f2);
unlink(f1);
#else
rename(f1, f2);
#endif
/* what if it fails??? */
}
Visible Procedure f_delete(fname) value fname; {
unlink(strval(fname));
}
Visible bool
f_exists(file)
string file;
{
FILE *f= fopen(file, "r");
if (f==NULL) return No;
fclose(f);
return Yes;
}
#ifndef INTEGRATION
Hidden Procedure app_fname(ceos, fname) string ceos; value fname; {
string fp= strval(fname); intlet k, len= strlen(fp);
*ceos++= ' ';
k_Over_len {
*ceos++= '\\';
*ceos++= *fp++; /*should really use charval(thof(...))*/
}
*ceos= '\0';
}
#endif
Visible unsigned f_size(ifile) FILE *ifile; {
long size, ftell();
fseek(ifile, 0l, 2);
size= ftell(ifile);
fseek(ifile, 0l, 0); /* rewind */
return size;
}
Visible Procedure f_close(ofile) FILE *ofile; {
bool ok= fflush(ofile) != EOF;
if (fclose(ofile) == EOF || !ok)
error(MESS(3203, "write error (disk full?)"));
}
Visible bool f_interactive(ifile) FILE *ifile; {
#ifdef ISATTY
return isatty(fileno(ifile));
#else
return fileno(ifile) < 3;
#endif
}
#ifdef IBMPC
#define FNMLEN 8
#define TYPLEN 3
#define SPCLEN 1
#define FHW "how"
#define FZR "zer"
#define FMN "mon"
#define FDY "dya"
#define FTR "tar"
Hidden string
filetype(type)
literal type;
{
switch (type) {
case Zer: return FZR;
case Mon: return FMN;
case Dya: return FDY;
case How: return FHW;
case Tar: return FTR;
default: syserr(MESS(3200, "filetype()"));
/* NOTREACHED */
}
}
Hidden Procedure
cr_fname(name, type, fname, len, pname)
value name; string fname, *pname; literal type; int len;
{
*pname= fname;
strncpy(*pname, strval(name), len);
sprintf(fname + len, ".%s", filetype(type));
}
#endif IBMPC
#ifdef unix
#define FNMLEN 12
#define TYPLEN 1
#define SPCLEN 0
#define FHW '\''
#define FZR '<'
#define FMN '"'
#define FDY '>'
#define FTR '='
Hidden literal
filetype(type)
literal type;
{
switch (type) {
case Zer: return FZR;
case Mon: return FMN;
case Dya: return FDY;
case How: return FHW;
case Tar: return FTR;
default: syserr(MESS(3201, "filetype()"));
/* NOTREACHED */
}
}
Hidden Procedure
cr_fname(name, type, fname, len, pname)
value name; string fname, *pname; literal type; int len;
{
*fname= filetype(type);
fname[1]= '\0';
*pname= fname + 1;
strncat(fname, strval(name), len);
}
#endif unix
Hidden bool
exists(name)
string name;
{
value v= mk_text(name);
bool exist= in(v, file_names);
release(v);
return exist;
}
Visible value
new_fname(name, type)
value name; literal type;
{
char fname[FNMLEN + TYPLEN + SPCLEN + 1];
intlet len= length(name);
string pname;
if (len > FNMLEN) len= FNMLEN;
cr_fname(name, type, fname, len, &pname);
while (exists(fname)) new(pname, len-1);
return mk_text(fname);
}
#include <ctype.h>
Hidden Procedure
new(name, n)
string name; int n;
{
if (n < 1) error(MESS(3202, "too many units"));
else if (!isdigit(name[n])) name[n]= '1';
else if (name[n] != '9') ++name[n];
else {
name[n]= '0';
new(name, --n);
}
}